<<KnotTheory`

NormalizePD[K_PD]:= K/.i_Integer :> Mod[i, 2 Crossings[K]];
FlipCrossing[X[i_,j_,k_,l_]]:=If[PositiveQ[ X[i,j,k,l]],X[l,i,j,k], X[j,k,l,i]];
FirstEdge[i_,j_]:= If[Abs[j-i]==1,Min[i,j], Max[i,j]];
OrderKnot[K_PD]:= Association @@ Flatten @ (List @@ K/.X[i_,j_,k_,l_]:> {i-> X[i,j,k,l], FirstEdge[j,l]->X[i,j,k,l]});

HomflyptCoefficient[K_PD, n_]:= Module[{m, L, OK, UnderCrossingQ, P, Linking},
m = 2 Crossings[K];L = NormalizePD[K];OK =OrderKnot[L];
UnderCrossingQ[i_]:= (First @ OK[i]==i);
P[k_,i_,j_]:=P[k,i,j] = Expand @ Module[{t},
Piecewise[{
{If[k==0,1,0],j-i≤ 4},
{P[k,i+1,j], t = FirstEdge @@ OK[i][[{2,4}]]; Not @ UnderCrossingQ[i] ||Not[ i<t≤j]}},
If[PositiveQ[OK[i]], -(a^(-2))P[k,i+1,j] + (a^(-1)) P[k,i,j,t], -(a^2)P[k,i+1,j] + a P[k,i,j,t]]
]];
Linking[i_,j_, t_]:=Sum[If[UnderCrossingQ[l]&&(i+1≤FirstEdge @@ OK[l][[{2,4}]]≤t-1), If[PositiveQ[OK[l]],1,-1], 0],{l,t+1,j-1}];
P[0,i_,j_,t_]:=(((-(a^(-2))))^( Linking[i,j,t]))(a + ((a )^(-1)))P[ 0,i+1,t] P[0,t+1,j];
P[k_,i_,j_,t_]:= Module[{FlipCheck, e, Smooth, D, T, D0},
FlipCheck[X[a_,b_,c_,d_]]:= (e = FirstEdge[b,d];(a<i && Not[a<e<i]) ||( a ≥j && a>e > i));
Smooth[D_,s_]:= Module[{r, d1, d2, d3, A},
r= FirstEdge @@ OK[s][[{2,4}]];
d1 = i + s - (t+1); d2 = d1 + t - (r+1); d3 = d2 + r - (i+1);
A=AssociationThread[Range[0,i]~Join~Range[t+1,s]~Join~Range[r+1,t]~Join~Range[i+1,r]~Join~Range[s+1,m-1]->Range[0,i]~Join~Range[i,d1]~Join~Range[d1,d2]~Join~Range[d2,d3]~Join~Range[d3, m -5]];
D/.X[a_,b_,c_,d_]:> If[MatchQ[X[a,b,c,d],OK[s]], ##&[], X[A[a],A[b],A[c],A[d]]]];
T[j]:= (a + (a^(-1)))Sum[P[2r,i+1,t] P[k-2r,t+1,j],{r,0,(k/2)}];
T[s_]:=If[UnderCrossingQ[s] && i+1≤ FirstEdge @@ OK[s][[{2,4}]]≤t-1,
D0 = Smooth[D, s]; D = D/. OK[s]:>FlipCrossing[OK[s]];
If[PositiveQ[OK[s]], (a^(-1))HomflyptCoefficient[D0,k-2]-(a^(-2))T[s + 1],a HomflyptCoefficient[D0,k-2]- (a^2)T[s+ 1]],T[s + 1]];
D = L/.x_X:>If[MatchQ[x,OK[i]],##&[], If[FlipCheck[x], FlipCrossing[x],x]]; 
T[t+1]
];
  P[n,0,m] 
];

HomflyptCoefficient[K_,n_]:= HomflyptCoefficient[PD @ K, n];